home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / databa_1 / dbgrid.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-07-10  |  22.5 KB  |  663 lines
  1. VERSION 5.00
  2. Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
  3. Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
  4. Begin VB.Form frmDBGrid 
  5.    Caption         =   "Records"
  6.    ClientHeight    =   4950
  7.    ClientLeft      =   60
  8.    ClientTop       =   345
  9.    ClientWidth     =   8595
  10.    Icon            =   "DBGrid.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MDIChild        =   -1  'True
  13.    ScaleHeight     =   4950
  14.    ScaleWidth      =   8595
  15.    Begin VB.PictureBox pbx2 
  16.       Height          =   375
  17.       Left            =   360
  18.       ScaleHeight     =   315
  19.       ScaleWidth      =   765
  20.       TabIndex        =   16
  21.       Top             =   4410
  22.       Width           =   825
  23.       Begin VB.CommandButton cmdSearch 
  24.          Caption         =   "Search"
  25.          Enabled         =   0   'False
  26.          BeginProperty Font 
  27.             Name            =   "MS Sans Serif"
  28.             Size            =   8.25
  29.             Charset         =   0
  30.             Weight          =   700
  31.             Underline       =   0   'False
  32.             Italic          =   0   'False
  33.             Strikethrough   =   0   'False
  34.          EndProperty
  35.          Height          =   330
  36.          Left            =   0
  37.          TabIndex        =   17
  38.          Top             =   0
  39.          Width           =   780
  40.       End
  41.    End
  42.    Begin VB.PictureBox pbx1 
  43.       Height          =   405
  44.       Left            =   360
  45.       ScaleHeight     =   345
  46.       ScaleWidth      =   6825
  47.       TabIndex        =   1
  48.       Top             =   3870
  49.       Width           =   6885
  50.       Begin VB.CommandButton cmdChange 
  51.          Caption         =   "Change"
  52.          Enabled         =   0   'False
  53.          BeginProperty Font 
  54.             Name            =   "MS Sans Serif"
  55.             Size            =   8.25
  56.             Charset         =   0
  57.             Weight          =   700
  58.             Underline       =   0   'False
  59.             Italic          =   0   'False
  60.             Strikethrough   =   0   'False
  61.          EndProperty
  62.          Height          =   345
  63.          Left            =   3330
  64.          TabIndex        =   18
  65.          Top             =   0
  66.          Width           =   870
  67.       End
  68.       Begin VB.CommandButton cmdFieldProperties 
  69.          Appearance      =   0  'Flat
  70.          BackColor       =   &H00C0E0FF&
  71.          BeginProperty Font 
  72.             Name            =   "MS Sans Serif"
  73.             Size            =   8.25
  74.             Charset         =   0
  75.             Weight          =   700
  76.             Underline       =   0   'False
  77.             Italic          =   0   'False
  78.             Strikethrough   =   0   'False
  79.          EndProperty
  80.          Height          =   345
  81.          Left            =   1320
  82.          Style           =   1  'Graphical
  83.          TabIndex        =   15
  84.          ToolTipText     =   "Field properties"
  85.          Top             =   0
  86.          Width           =   240
  87.       End
  88.       Begin VB.CommandButton cmdRSProperties 
  89.          Appearance      =   0  'Flat
  90.          BackColor       =   &H00FFFFC0&
  91.          BeginProperty Font 
  92.             Name            =   "MS Sans Serif"
  93.             Size            =   8.25
  94.             Charset         =   0
  95.             Weight          =   700
  96.             Underline       =   0   'False
  97.             Italic          =   0   'False
  98.             Strikethrough   =   0   'False
  99.          EndProperty
  100.          Height          =   345
  101.          Left            =   1080
  102.          Style           =   1  'Graphical
  103.          TabIndex        =   14
  104.          ToolTipText     =   "Recordset properties"
  105.          Top             =   0
  106.          Width           =   240
  107.       End
  108.       Begin VB.CommandButton cmdRSSupports 
  109.          Appearance      =   0  'Flat
  110.          BackColor       =   &H80000018&
  111.          BeginProperty Font 
  112.             Name            =   "MS Sans Serif"
  113.             Size            =   8.25
  114.             Charset         =   0
  115.             Weight          =   700
  116.             Underline       =   0   'False
  117.             Italic          =   0   'False
  118.             Strikethrough   =   0   'False
  119.          EndProperty
  120.          Height          =   345
  121.          Left            =   840
  122.          Style           =   1  'Graphical
  123.          TabIndex        =   12
  124.          ToolTipText     =   "Recordset supports"
  125.          Top             =   0
  126.          Width           =   240
  127.       End
  128.       Begin VB.CommandButton cmdRefresh 
  129.          Caption         =   "Refresh"
  130.          Enabled         =   0   'False
  131.          BeginProperty Font 
  132.             Name            =   "MS Sans Serif"
  133.             Size            =   8.25
  134.             Charset         =   0
  135.             Weight          =   700
  136.             Underline       =   0   'False
  137.             Italic          =   0   'False
  138.             Strikethrough   =   0   'False
  139.          EndProperty
  140.          Height          =   345
  141.          Left            =   0
  142.          TabIndex        =   11
  143.          Top             =   0
  144.          Width           =   825
  145.       End
  146.       Begin VB.CommandButton cmdAdd 
  147.          Caption         =   "Add"
  148.          Enabled         =   0   'False
  149.          BeginProperty Font 
  150.             Name            =   "MS Sans Serif"
  151.             Size            =   8.25
  152.             Charset         =   0
  153.             Weight          =   700
  154.             Underline       =   0   'False
  155.             Italic          =   0   'False
  156.             Strikethrough   =   0   'False
  157.          EndProperty
  158.          Height          =   345
  159.          Left            =   1560
  160.          TabIndex        =   6
  161.          Top             =   0
  162.          Width           =   915
  163.       End
  164.       Begin VB.CommandButton cmdDelete 
  165.          Caption         =   "Delete"
  166.          Enabled         =   0   'False
  167.          BeginProperty Font 
  168.             Name            =   "MS Sans Serif"
  169.             Size            =   8.25
  170.             Charset         =   0
  171.             Weight          =   700
  172.             Underline       =   0   'False
  173.             Italic          =   0   'False
  174.             Strikethrough   =   0   'False
  175.          EndProperty
  176.          Height          =   345
  177.          Left            =   2460
  178.          TabIndex        =   5
  179.          Top             =   0
  180.          Width           =   870
  181.       End
  182.       Begin VB.CommandButton cmdClose 
  183.          Caption         =   "Close"
  184.          BeginProperty Font 
  185.             Name            =   "MS Sans Serif"
  186.             Size            =   8.25
  187.             Charset         =   0
  188.             Weight          =   700
  189.             Underline       =   0   'False
  190.             Italic          =   0   'False
  191.             Strikethrough   =   0   'False
  192.          EndProperty
  193.          Height          =   345
  194.          Left            =   5940
  195.          TabIndex        =   4
  196.          Top             =   0
  197.          Width           =   870
  198.       End
  199.       Begin VB.CommandButton cmdSave 
  200.          Caption         =   "Save"
  201.          Enabled         =   0   'False
  202.          BeginProperty Font 
  203.             Name            =   "MS Sans Serif"
  204.             Size            =   8.25
  205.             Charset         =   0
  206.             Weight          =   700
  207.             Underline       =   0   'False
  208.             Italic          =   0   'False
  209.             Strikethrough   =   0   'False
  210.          EndProperty
  211.          Height          =   345
  212.          Left            =   5070
  213.          TabIndex        =   3
  214.          Top             =   0
  215.          Width           =   870
  216.       End
  217.       Begin VB.CommandButton cmdAbort 
  218.          Caption         =   "Abort"
  219.          Enabled         =   0   'False
  220.          BeginProperty Font 
  221.             Name            =   "MS Sans Serif"
  222.             Size            =   8.25
  223.             Charset         =   0
  224.             Weight          =   700
  225.             Underline       =   0   'False
  226.             Italic          =   0   'False
  227.             Strikethrough   =   0   'False
  228.          EndProperty
  229.          Height          =   345
  230.          Left            =   4200
  231.          TabIndex        =   2
  232.          Top             =   0
  233.          Width           =   870
  234.       End
  235.    End
  236.    Begin MSDataGridLib.DataGrid DataGrid1 
  237.       Height          =   3030
  238.       Left            =   315
  239.       TabIndex        =   0
  240.       Top             =   765
  241.       Width           =   7800
  242.       _ExtentX        =   13758
  243.       _ExtentY        =   5345
  244.       _Version        =   393216
  245.       AllowUpdate     =   -1  'True
  246.       AllowArrows     =   -1  'True
  247.       HeadLines       =   1
  248.       RowHeight       =   15
  249.       AllowAddNew     =   -1  'True
  250.       AllowDelete     =   -1  'True
  251.       BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  252.          Name            =   "MS Sans Serif"
  253.          Size            =   8.25
  254.          Charset         =   0
  255.          Weight          =   400
  256.          Underline       =   0   'False
  257.          Italic          =   0   'False
  258.          Strikethrough   =   0   'False
  259.       EndProperty
  260.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  261.          Name            =   "MS Sans Serif"
  262.          Size            =   8.25
  263.          Charset         =   0
  264.          Weight          =   400
  265.          Underline       =   0   'False
  266.          Italic          =   0   'False
  267.          Strikethrough   =   0   'False
  268.       EndProperty
  269.       ColumnCount     =   2
  270.       BeginProperty Column00 
  271.          DataField       =   ""
  272.          Caption         =   ""
  273.          BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
  274.             Type            =   0
  275.             Format          =   ""
  276.             HaveTrueFalseNull=   0
  277.             FirstDayOfWeek  =   0
  278.             FirstWeekOfYear =   0
  279.             LCID            =   1033
  280.             SubFormatType   =   0
  281.          EndProperty
  282.       EndProperty
  283.       BeginProperty Column01 
  284.          DataField       =   ""
  285.          Caption         =   ""
  286.          BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
  287.             Type            =   0
  288.             Format          =   ""
  289.             HaveTrueFalseNull=   0
  290.             FirstDayOfWeek  =   0
  291.             FirstWeekOfYear =   0
  292.             LCID            =   1033
  293.             SubFormatType   =   0
  294.          EndProperty
  295.       EndProperty
  296.       SplitCount      =   1
  297.       BeginProperty Split0 
  298.          AllowSizing     =   0   'False
  299.          BeginProperty Column00 
  300.          EndProperty
  301.          BeginProperty Column01 
  302.          EndProperty
  303.       EndProperty
  304.    End
  305.    Begin VB.PictureBox pbx3 
  306.       Height          =   375
  307.       Left            =   1215
  308.       ScaleHeight     =   315
  309.       ScaleWidth      =   720
  310.       TabIndex        =   9
  311.       Top             =   4410
  312.       Width           =   780
  313.       Begin VB.CommandButton cmdFields 
  314.          Caption         =   "Fields"
  315.          Enabled         =   0   'False
  316.          BeginProperty Font 
  317.             Name            =   "MS Sans Serif"
  318.             Size            =   8.25
  319.             Charset         =   0
  320.             Weight          =   700
  321.             Underline       =   0   'False
  322.             Italic          =   0   'False
  323.             Strikethrough   =   0   'False
  324.          EndProperty
  325.          Height          =   330
  326.          Left            =   -45
  327.          TabIndex        =   10
  328.          Top             =   0
  329.          Width           =   780
  330.       End
  331.    End
  332.    Begin MSAdodcLib.Adodc Adodc1 
  333.       Height          =   375
  334.       Left            =   3660
  335.       Top             =   4410
  336.       Width           =   1935
  337.       _ExtentX        =   3413
  338.       _ExtentY        =   661
  339.       ConnectMode     =   3
  340.       CursorLocation  =   3
  341.       IsolationLevel  =   -1
  342.       ConnectionTimeout=   15
  343.       CommandTimeout  =   30
  344.       CursorType      =   3
  345.       LockType        =   3
  346.       CommandType     =   8
  347.       CursorOptions   =   0
  348.       CacheSize       =   50
  349.       MaxRecords      =   0
  350.       BOFAction       =   0
  351.       EOFAction       =   0
  352.       ConnectStringType=   1
  353.       Appearance      =   1
  354.       BackColor       =   -2147483643
  355.       ForeColor       =   -2147483640
  356.       Orientation     =   0
  357.       Enabled         =   -1
  358.       Connect         =   ""
  359.       OLEDBString     =   ""
  360.       OLEDBFile       =   ""
  361.       DataSourceName  =   ""
  362.       OtherAttributes =   ""
  363.       UserName        =   ""
  364.       Password        =   ""
  365.       RecordSource    =   ""
  366.       Caption         =   "Adodc1"
  367.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  368.          Name            =   "MS Sans Serif"
  369.          Size            =   8.25
  370.          Charset         =   0
  371.          Weight          =   400
  372.          Underline       =   0   'False
  373.          Italic          =   0   'False
  374.          Strikethrough   =   0   'False
  375.       EndProperty
  376.       _Version        =   393216
  377.    End
  378.    Begin VB.Label lblrecordcount 
  379.       BorderStyle     =   1  'Fixed Single
  380.       BeginProperty Font 
  381.          Name            =   "MS Sans Serif"
  382.          Size            =   9.75
  383.          Charset         =   0
  384.          Weight          =   400
  385.          Underline       =   0   'False
  386.          Italic          =   0   'False
  387.          Strikethrough   =   0   'False
  388.       EndProperty
  389.       Height          =   375
  390.       Left            =   5700
  391.       TabIndex        =   13
  392.       Top             =   4410
  393.       Width           =   1515
  394.    End
  395.    Begin VB.Label lblTable 
  396.       Caption         =   "lblTable"
  397.       Height          =   240
  398.       Left            =   360
  399.       TabIndex        =   8
  400.       Top             =   450
  401.       Width           =   6810
  402.    End
  403.    Begin VB.Label lblDatabase 
  404.       Caption         =   "lblDatabase"
  405.       Height          =   285
  406.       Left            =   360
  407.       TabIndex        =   7
  408.       Top             =   180
  409.       Width           =   6900
  410.    End
  411. Attribute VB_Name = "frmDBGrid"
  412. Attribute VB_GlobalNameSpace = False
  413. Attribute VB_Creatable = False
  414. Attribute VB_PredeclaredId = True
  415. Attribute VB_Exposed = False
  416. ' DBGrid.frm
  417. ' By Herman Liu
  418. Option Explicit
  419. Dim WithEvents rs As adodb.Recordset
  420. Attribute rs.VB_VarHelpID = -1
  421. Dim mbookmark As Variant
  422. Dim mreccount As Integer
  423. Dim mNoRowSetYet As Boolean
  424. Private Sub Form_Load()
  425.     On Error GoTo errhandler
  426.     mNoRowSetYet = True
  427.       ' Show a dummy default first, in case error would occur
  428.     Adodc1.Caption = "0"
  429.     Set rs = New Recordset
  430.     Me.lblDatabase = "Database:  " + gFileSpec
  431.     Me.lblTable = "Table:  " + gTableName
  432.     rs.Open "select * from [" & gTableName & "]", gAcnn, adOpenStatic, adLockOptimistic
  433.     If rs.EOF Then
  434.          mreccount = 0
  435.          MsgBox "No record in table"
  436.          Exit Sub
  437.     End If
  438.     Set Adodc1.Recordset = rs
  439.     Set DataGrid1.DataSource = rs
  440.        ' Make sure edit of cells is NOT allowed
  441.     DataGrid1.Splits(0).Locked = True
  442.        ' Disallow splits of grid
  443.     DataGrid1.Splits(0).AllowSizing = False
  444.     DataGrid1.Splits(0).AllowFocus = True
  445.     DataGrid1.Splits(0).AllowRowSizing = True
  446.     DataGrid1.Splits(0).RecordSelectors = True
  447.     DataGrid1.Refresh
  448.     Dim i As Integer, j As Integer
  449.     Dim mfldcount
  450.     Dim k As Boolean
  451.     Dim s As String
  452.     rs.MoveLast
  453.     rs.MoveFirst
  454.     mreccount = rs.RecordCount
  455.     Me.lblrecordcount = "Total:  " & mreccount
  456.     mfldcount = rs.Fields.Count
  457.       ' We exclude adVarBinary (type=204), adlongVarBinary (205)
  458.       ' adBinary (type=128) types of fields in the grid and
  459.       ' adBSTR (type=8).
  460.       ' Identify the subscript position in gstrFieldsOrig() for the current
  461.       ' table.  gstrFields and gstrFieldsOrig are same size.
  462.       ' As form is being loaded, cannot call GetSubscript() yet, refer value
  463.       ' of gTableName instead.
  464.     Dim msubscript As Integer
  465.     j = 0
  466.     For i = 0 To UBound(gstrFieldsOrig) - 1
  467.         s = gstrFieldsOrig(i, 1)
  468.         If s = gTableName Then
  469.             Exit For
  470.         End If
  471.         j = j + 1
  472.     Next
  473.     msubscript = j
  474.     gstrFieldsOrig(msubscript, 2) = ""
  475.     k = False
  476.     For i = 0 To mfldcount - 1
  477.             ' In order not to mistaken, e.g "5" as "205", in gconExcludeFieldTypes, uniform 3-digit
  478.          s = rs.Fields(i).Type
  479.          If Len(s) < 3 Then
  480.               s = s & "XX"
  481.          End If
  482.          If InStr(gconexcludeFieldTypes, s) <> 0 Then
  483.               DataGrid1.Columns(i).Visible = False
  484.               k = True
  485.          Else
  486.                ' Get a copy for gstrFieldsOrig for use in cmdFields
  487.               gstrFieldsOrig(msubscript, 2) = gstrFieldsOrig(msubscript, 2) & rs.Fields(i).Name & ","
  488.          End If
  489.     Next i
  490.       ' Don't get rid of last "," for gstrFieldsorig; it just serves the purpose
  491.     If k = True Then
  492.          Me.Caption = "Records:  [Binary field(s) excluded]"
  493.     End If
  494.         ' There is a rowset to highlight now
  495.     mNoRowSetYet = False
  496.         ' Hightlight first row of Datagrid.
  497.     DataGrid1.SelBookmarks.Add rs.Bookmark
  498.     Adodc1.Caption = CStr(rs.AbsolutePosition)
  499.        ' Disable record edit buttons
  500.     cmdAdd.Enabled = False
  501.     cmdDelete.Enabled = False
  502.     cmdChange.Enabled = False
  503.     cmdAbort.Enabled = False
  504.     cmdSave.Enabled = False
  505.     cmdRefresh.Enabled = False
  506.        ' Since query can have link relationship, don't allow selection
  507.        ' of individual fields
  508.     Exit Sub
  509. errhandler:
  510.     mreccount = 0
  511.     ErrMsgProc "frmDBGrid Form_load. Failed to establish a connection"
  512. End Sub
  513. Private Sub Form_Resize()
  514.    If Me.WindowState = vbMinimized Then
  515.         Exit Sub
  516.    End If
  517.    DataGrid1.Width = Me.Width - 800
  518.    DataGrid1.Height = Me.Height - 2600
  519.    pbx1.Top = (DataGrid1.Top + DataGrid1.Height) + 200
  520.    Adodc1.Top = (pbx1.Top + pbx1.Height) + 200
  521.    lblrecordcount.Top = Adodc1.Top
  522.    pbx2.Top = Adodc1.Top
  523.    pbx3.Top = Adodc1.Top
  524. End Sub
  525. Private Sub Form_Unload(Cancel As Integer)
  526.    On Error Resume Next
  527.    rs.Close
  528.    Set rs = Nothing
  529.    Exit Sub
  530. End Sub
  531. ' Here this event procedure is for highlight of current record
  532. Private Sub Adodc1_MoveComplete(ByVal adReason As adodb.EventReasonEnum, ByVal pError As adodb.Error, adStatus As adodb.EventStatusEnum, ByVal pRecordset As adodb.Recordset)
  533.    On Error GoTo errhandler
  534.    If mNoRowSetYet Then
  535.        Exit Sub
  536.    End If
  537.       ' Avoid user going too far at both ends
  538.    If rs.BOF Or rs.EOF() Then
  539.        Exit Sub
  540.    End If
  541.    If mreccount > 0 Then
  542.        Adodc1.Caption = CStr(rs.AbsolutePosition)
  543.          ' Remove all highlights first
  544.        Do While DataGrid1.SelBookmarks.Count > 0
  545.            DataGrid1.SelBookmarks.Remove 0
  546.        Loop
  547.          ' Highlight the current row
  548.        DataGrid1.SelBookmarks.Add rs.Bookmark
  549.    Else
  550.        Adodc1.Caption = "0"
  551.    End If
  552.    Exit Sub
  553. errhandler:
  554.    ErrMsgProc "frmDBGrid Adodc1_Movecomplete"
  555. End Sub
  556. Private Sub cmdRSSupports_Click()
  557.     If mreccount = 0 Then
  558.         MsgBox "No record in table"
  559.         Exit Sub
  560.     End If
  561.     Dim mStrYes As String, mStrNo As String
  562.     mStrYes = "": mStrNo = ""
  563.     If (rs.Supports(adAddNew)) Then
  564.         mStrYes = mStrYes & "  adAddNew" & vbCrLf
  565.     Else
  566.         mStrNo = mStrNo & "  adAddNew" & vbCrLf
  567.     End If
  568.     If rs.Supports(adDelete) Then
  569.         mStrYes = mStrYes & "  adDelete" & vbCrLf
  570.     Else
  571.         mStrNo = mStrNo & "  adDelete" & vbCrLf
  572.     End If
  573.     If rs.Supports(adUpdate) Then
  574.         mStrYes = mStrYes & "  adUpdate" & vbCrLf
  575.     Else
  576.         mStrNo = mStrNo & "  adUpdate" & vbCrLf
  577.     End If
  578.     If rs.Supports(adUpdateBatch) Then
  579.         mStrYes = mStrYes & "  adUpdateBatch" & vbCrLf
  580.     Else
  581.         mStrNo = mStrNo & "  adUpdateBatch" & vbCrLf
  582.     End If
  583.     If rs.Supports(adResync) Then
  584.         mStrYes = mStrYes & "  adResync" & vbCrLf
  585.     Else
  586.         mStrNo = mStrNo & "  adResync" & vbCrLf
  587.     End If
  588.     If rs.Supports(adBookmark) Then
  589.         mStrYes = mStrYes & "  adBookmark" & vbCrLf
  590.     Else
  591.         mStrNo = mStrNo & "  adBookmark" & vbCrLf
  592.     End If
  593.     If rs.Supports(adApproxPosition) Then
  594.         mStrYes = mStrYes & "  adApproxPosition" & vbCrLf
  595.     Else
  596.         mStrNo = mStrNo & "  adApproxPosition" & vbCrLf
  597.     End If
  598.     If rs.Supports(adMovePrevious) Then
  599.         mStrYes = mStrYes & "  adMovePrevious" & vbCrLf
  600.     Else
  601.         mStrNo = mStrNo & "  adMovePrevious" & vbCrLf
  602.     End If
  603.     MsgBox "Following are supported:" & vbCrLf & mStrYes & vbCrLf & _
  604.            "Following are not supported:" & vbCrLf & mStrNo & vbCrLf
  605. End Sub
  606. Private Sub cmdRSProperties_Click()
  607.     If mreccount = 0 Then
  608.         MsgBox "No record in table"
  609.         Exit Sub
  610.     End If
  611.     Dim c As String, l As String
  612.     Dim e As String, s As String, t As String
  613.     c = Space(2) & ConvCursorType(rs.CursorType)
  614.     l = Space(2) & ConvLockType(rs.LockType)
  615.     e = ConvEditMode(rs.EditMode)
  616.     s = ConvState(rs.State)
  617.     t = ConvStatus(rs.Status)
  618.     MsgBox "CursorType:" & vbCrLf & c & vbCrLf & vbCrLf & _
  619.         "LockType: " & vbCrLf & l & vbCrLf & vbCrLf & _
  620.         "Current state and status:" & vbCrLf & _
  621.         "  EditMode: " & e & vbCrLf & _
  622.         "  State: " & s & vbCrLf & _
  623.         "  Status: " & t & vbCrLf
  624. End Sub
  625. ' Display similar field properties as in frmTablesTVW
  626. Private Sub cmdFieldProperties_Click()
  627.     If mreccount = 0 Then
  628.         MsgBox "No record in table"
  629.         Exit Sub
  630.     End If
  631.     Dim mthisFldName As String
  632.     Dim mType As Long
  633.     Dim mAttr
  634.     Dim mstrType As String
  635.     Dim mstrAttr As String
  636.     Dim mDefinedSize
  637.     Dim mNumericScale
  638.     Dim mPrecision
  639.        ' Relying on current column caption to get field name
  640.     mthisFldName = DataGrid1.Columns(DataGrid1.Col).Caption
  641.     mType = rs.Fields(mthisFldName).Type
  642.     mstrType = ConvType(mType)
  643.     mAttr = rs.Fields(mthisFldName).Attributes
  644.     mstrAttr = ConvAttr(mAttr)
  645.     mDefinedSize = rs.Fields(mthisFldName).DefinedSize
  646.     mNumericScale = rs.Fields(mthisFldName).NumericScale
  647.     mPrecision = rs.Fields(mthisFldName).Precision
  648.     MsgBox "Field properties:" & vbCrLf & _
  649.            "  Name: " & mthisFldName & vbCrLf & _
  650.            "  Type: " & mstrType & vbCrLf & _
  651.            "  Attributes: " & mstrAttr & vbCrLf & _
  652.            "  DefinedSize: " & mDefinedSize & vbCrLf & _
  653.            "  NumericScale: " & mNumericScale & vbCrLf & _
  654.            "  Precision: " & mPrecision & vbCrLf
  655.            
  656. End Sub
  657. Private Sub cmdClose_Click()
  658.    On Error Resume Next
  659.    rs.Close
  660.    Set rs = Nothing
  661.    Unload Me
  662. End Sub
  663.